home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Gold Medal Software 2
/
Gold Medal Software Volume 2 (Gold Medal) (1994).iso
/
prog
/
sprite21.arj
/
ROTATES.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-07-08
|
6KB
|
206 lines
program RotateSprite;
{ Written by Scott Harbour
Released 15-April-92
Compiles with Turbo Pascal 5.0+ }
uses crt,graph,library,bgidriv;
{$M 64000,0,655360}
const spritesize = 30;
x1 = 95; y1 = 95; x2 = 135; y2 = 125;
type SpriteInfo = RECORD
name : STRING[40];
loc : ARRAY[0..SpriteSize-1,0..SpriteSize-1] OF SHORTINT;
END;
movement = (invert,rotate);
var spritefile : file of spriteinfo;
sprite2,sprite : spriteinfo;
img : array [1..16] of pointer;
dist,n,gd,gm : integer;
r : real;
key : char;
PROCEDURE GetPic(VAR pic : POINTER);
VAR size : WORD;
BEGIN
size := IMAGESIZE(x1,y1,x2,y2);
GETMEM(pic,size);
GETIMAGE(x1,y1,x2,y2,pic^);
END; { GetPic }
PROCEDURE LoadSprite(fn,spr : string; var sprite : spriteinfo);
VAR count,h,k,x1,y1,x2,y2 : WORD;
BEGIN
if pos('.',fn) = 0 then fn := fn + '.SCF';
ASSIGN(SpriteFile,fn);
{$I-} RESET(SpriteFile); {$I+}
IF IORESULT <> 0 THEN
BEGIN
textmode(co80);
writeln('Sprite file not found - ',UpperCase(fn));
halt(1);
END;
count := 0;
RESET(SpriteFile);
WHILE NOT EOF(SpriteFile) DO
BEGIN
READ(SpriteFile,Sprite);
INC(count);
END;
IF count > 1 THEN
BEGIN
RESET(SpriteFile);
WHILE (spr<>Sprite.name) AND (NOT EOF(SpriteFile)) DO
READ(SpriteFile,Sprite);
IF spr <> Sprite.name THEN
BEGIN
TEXTMODE(co80);
WRITELN('Sprite not found - ',UpperCase(fn), ' | ',UpperCase(spr));
halt(1);
END;
{$I-} CLOSE(SpriteFile); {$I+}
END ELSE
BEGIN
RESET(SpriteFile);
READ(SpriteFile,Sprite);
CLOSE(SpriteFile);
END;
FOR h := 0 TO 29 DO
FOR k := 0 TO 29 DO
if sprite.loc[h,k] = -1 then sprite.loc[h,k] := 0;
END; { LoadSprite }
procedure showsprite(sprite : spriteinfo; x,y : word);
var h,k,c : shortint;
begin
FOR h := 0 TO 29 DO
FOR k := 0 TO 29 DO
if sprite.loc[h,k] <> 0 then
putpixel(x+h,y+k,sprite.loc[h,k]);
end;
procedure rotate_sprite(sprite : spriteinfo; dist,startx,starty : integer);
const ratio = 0.7; rot = 0.017453;
var x,y,oldx,oldy : array [0..29,0..29] of real;
angle : real;
firstx,firsty,lastx,lasty,h,k : integer;
c : array [0..29,0..29] of word;
begin
angle := dist * rot;
for h := 0 to 29 do
for k := 0 to 29 do
if sprite.loc[h,k] <> 0 then
begin
c[h,k] := sprite.loc[h,k];
x[h,k] := h; y[h,k] := k;
oldx[h,k] := x[h,k]; oldy[h,k] := y[h,k];
x[h,k] := (oldx[h,k] * cos(angle))+(oldy[h,k] * sin(angle));
y[h,k] := (oldy[h,k] * cos(angle))-(oldx[h,k] * sin(angle));
if c[h,k] <> 0 then
putpixel(startx+round(x[h,k]),starty+round(y[h,k]*ratio),c[h,k]);
end;
end; { rotate_sprite }
procedure AlterImage(var sprite : spriteinfo; mvt : MOVEMENT);
VAR h,k,x,y : WORD;
Temp : SpriteInfo;
BEGIN
FOR x := 0 TO SpriteSize-1 DO
FOR y := 0 TO SpriteSize-1 DO
BEGIN
CASE mvt OF
ROTATE : BEGIN
k := SpriteSize-1-x;
h := SpriteSize-1-y
END;
INVERT : BEGIN
h := x;
k := SpriteSize-1-y;
END;
END;
Temp.loc[h,k] := Sprite.loc[x,y];
END;
sprite := Temp;
END; { AlterImage }
procedure movearound;
var ship : array [1..16] of pointer;
begin
for n := 1 to 16 do ship[n] := img[n];
settextstyle(defaultfont,horizdir,1);
setcolor(white);
outtextxy(0,0,'Press LEFT or RIGHT to rotate, ESC to quit');
n := 1; dist := 16;
repeat
putimage(x1,y1,ship[n]^,normalput);
key := readkey;
case key of
#77 : begin
putimage(x1,y1,ship[n]^,normalput);
inc(n);
if n > dist then n := 1;
end;
#75 : begin
putimage(x1,y1,ship[n]^,normalput);
dec(n);
if n < 1 then n := dist;
end;
end;
until key = #27;
closegraph;
textmode(co80);
halt;
end; { movearound }
begin
if registerbgidriver(@egavgadriverproc) < 0 then
fatal('Graphics driver not found');
detectgraph(gd,gm);
if gd <> vga then fatal('VGA required');
gd := vga; gm := vgamed;
initgraph(gd,gm,'');
if graphresult <> 0 then fatal('Graphics driver failure!');
setlinestyle(solidln,0,1);
setcolor(white);
rectangle(x1-1,y1-1,x2+1,y2+1);
loadsprite('test','',sprite);
sprite2 := sprite;
rotate_sprite(sprite,0,100,99);
getpic(img[1]); putimage(x1,y1,img[1]^,xorput);
rotate_sprite(sprite,-23,108,96);
getpic(img[2]); putimage(x1,y1,img[2]^,xorput);
rotate_sprite(sprite,-45,116,96);
getpic(img[3]); putimage(x1,y1,img[3]^,xorput);
rotate_sprite(sprite,-67,124,96);
getpic(img[4]); putimage(x1,y1,img[4]^,xorput);
alterimage(sprite,rotate);
rotate_sprite(sprite,0,101,100);
getpic(img[5]); putimage(x1,y1,img[5]^,xorput);
rotate_sprite(sprite,-23,108,98);
getpic(img[6]); putimage(x1,y1,img[6]^,xorput);
rotate_sprite(sprite,-45,116,96);
getpic(img[7]); putimage(x1,y1,img[7]^,xorput);
rotate_sprite(sprite,-67,123,97);
getpic(img[8]); putimage(x1,y1,img[8]^,xorput);
sprite := sprite2;
alterimage(sprite,invert);
rotate_sprite(sprite,0,100,100);
getpic(img[9]); putimage(x1,y1,img[9]^,xorput);
rotate_sprite(sprite,-23,107,97);
getpic(img[10]); putimage(x1,y1,img[10]^,xorput);
rotate_sprite(sprite,-45,115,96);
getpic(img[11]); putimage(x1,y1,img[11]^,xorput);
rotate_sprite(sprite,-67,122,96);
getpic(img[12]); putimage(x1,y1,img[12]^,xorput);
rotate_sprite(sprite,-89,129,100);
getpic(img[13]); putimage(x1,y1,img[13]^,xorput);
rotate_sprite(sprite,-111,133,103);
getpic(img[14]); putimage(x1,y1,img[14]^,xorput);
rotate_sprite(sprite,-133,134,109);
getpic(img[15]); putimage(x1,y1,img[15]^,xorput);
rotate_sprite(sprite,-155,133,114);
getpic(img[16]); putimage(x1,y1,img[16]^,xorput);
movearound;
closegraph;
end.